home *** CD-ROM | disk | FTP | other *** search
- unit DQSelectV;
- {$I DQuery.inc}
-
- interface
-
- uses
- {$IFDEF WIN32}
- Windows, ComCtrls,
- {$ELSE}
- WinTypes, WinProcs,
- {$ENDIF}
- Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, Buttons, Db, DBTables;
-
- type
- TFormDQSelectValue = class(TForm)
- LBValue: TListBox;
- LValue: TLabel;
- BBOK: TBitBtn;
- BBCancel: TBitBtn;
- BBHelp: TBitBtn;
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure BBOKClick(Sender: TObject);
- procedure BBCancelClick(Sender: TObject);
- procedure BBHelpClick(Sender: TObject);
- private
- Query: TQuery;
- StFieldName:String;
- public
- bString: Boolean;
- StValue: String;
- Procedure GetFieldValueString (StDB, StTable,
- StAlias, StField: String; TempSession: TSession);
- end;
-
- var
- FormDQSelectValue: TFormDQSelectValue;
-
- implementation
-
- {$R *.DFM}
-
- Procedure TFormDQSelectValue.FormCreate(Sender: TObject);
- Begin
- Query := nil;
- bString := FALSE;
- End;
- Procedure TFormDQSelectValue.FormDestroy(Sender: TObject);
- Begin
- if Query <> nil Then
- Query.Free;
- FormDQSelectValue := nil;
- End;
- Procedure TFormDQSelectValue.FormClose(Sender: TObject;
- var Action: TCloseAction);
- Begin
- Action := caFree;
- End;
- Procedure TFormDQSelectValue.BBOKClick(Sender: TObject);
- Var
- ItemIndex: Integer;
- Field: TField;
- i: Integer;
- St: String;
- Begin
- ItemIndex := LBValue.ItemIndex;
- StValue := '';
- Field := Query.FieldByName(StFieldName);
- if ItemIndex >= 0 Then
- Begin
- if LBValue.MultiSelect Then
- Begin
- For i := 0 To LBValue.Items.Count - 1 Do
- Begin
- if not LBValue.Selected[i] Then Continue;
- St := LBValue.Items[i];
- if StValue <> '' Then
- StValue := StValue + ' , ';
- Case Field.DataType of
- ftSmallint,
- ftInteger,
- ftWord,
- ftBoolean,
- ftFloat,
- ftCurrency,
- ftBCD,
- ftBytes,
- ftAutoInc:
- StValue := StValue + St;
- Else
- StValue := StValue + '''' + St + ''''
- End;
- End;
- End
- Else
- Begin
- StValue := LBValue.Items.Strings[ItemIndex];
- Case Field.DataType of
- ftSmallint,
- ftInteger,
- ftWord,
- ftBoolean,
- ftFloat,
- ftCurrency,
- ftBCD,
- ftBytes,
- ftAutoInc:
- Begin
- End;
- Else
- StValue := '''' + StValue + '''';
- End;
- End;
- End;
- Close;
- ModalResult := mrOK;
- End;
- Procedure TFormDQSelectValue.BBCancelClick(Sender: TObject);
- Begin
- StValue := '';
- Close;
- ModalResult := mrCancel;
- End;
- Procedure TFormDQSelectValue.BBHelpClick(Sender: TObject);
- Begin
- Beep;
- End;
- Procedure TFormDQSelectValue.GetFieldValueString (StDB, StTable,
- StAlias, StField: String; TempSession: TSession);
- Var
- Cursor: TCursor;
- Field: TField;
- FieldDT: TDateTimeField;
- St: String;
- Begin
- if TempSession = nil Then
- TempSession := Session;
- LValue.Caption := 'Select value';
- StFieldName := StField;
- Query := TQuery.Create (Self);
- Query.SessionName := TempSession.SessionName;
- Query.SQL.Add('SELECT DISTINCT');
- Query.SQL.Add (Char(#09) + StField);
-
- {$IFDEF VERIFY_MSACCESS}
- St := TempSession.GetAliasDriverName (StDB);
- if St = 'MSACCESS' Then
- Begin
- Query.DatabaseName := StDB;
- Query.SQL.Add ('FROM [' + StTable + ']' + StAlias);
- End
- Else
- {$ENDIF}
- Query.SQL.Add ('FROM '':' + StDB + ':' + StTable + '''' + ' ' + StAlias);
-
- Cursor := Screen.Cursor;
- Screen.Cursor := crHourGlass;
- Try
- Query.Active := TRUE;
- Query.First;
- Field := Query.Fields[0];
- LBValue.Items.BeginUpdate;
- Try
- Case Field.DataType of
- ftDate:
- Begin
- FieldDT := TDateTimeField (Field);
- FieldDT.DisplayFormat := 'MM/DD/YYYY';
- End;
- ftTime:
- Begin
- FieldDT := TDateTimeField (Field);
- FieldDT.DisplayFormat := 'hh:mm:ss AM/PM';
- End;
- ftDateTime:
- Begin
- FieldDT := TDateTimeField (Field);
- FieldDT.DisplayFormat := 'MM/DD/YYYY hh:mm:ss AM/PM';
- End;
- Else
- FieldDT := nil;
- End;
- While not Query.EOF Do
- Begin
- if FieldDT <> nil Then
- Begin
- LBValue.Items.Add (FormatDateTime (FieldDT.DisplayFormat, FieldDT.AsDateTime));
- End
- Else
- LBValue.Items.Add (Field.AsString);
- if LBValue.Items.Count >= 300 Then Break;
- Query.Next;
- End;
- Finally
- LBValue.Items.EndUpdate;
- End;
- Finally
- Screen.Cursor := Cursor;
- End;
- End;
-
- End.
-